home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / graphics / cuscur / cursor.bas < prev    next >
Encoding:
BASIC Source File  |  1995-01-22  |  3.2 KB  |  104 lines
  1. ' Description
  2. ' -----------
  3. ' This is the code that accompanies an article I wrote for the
  4. ' December/January 1993/1994 edition of 'Visual Basic Programmer's Journal'.
  5. '
  6. ' It is a demonstration program showing how to create custom mouse pointers
  7. ' in VB 3.0 without using a Dynamic Link Library (DLL).  Cursor.bas is a
  8. ' reusable module that you can add easily to any project.
  9. '
  10. ' The article explains how the code works and how to create the icons that
  11. ' are used to make the cursors.
  12. '
  13. '
  14. ' What's new as of 1/22/95
  15. ' ------------------------
  16. ' Made adjustments to compensate for problems that occur with some video drivers
  17. ' in certain modes:
  18. ' 1) Replaced references to the icon's ScaleWidth and ScaleHeight with a constant.
  19. ' 2) When checking for the hot-spot, use a range of red colors.
  20. '
  21. '
  22. ' E-Mail
  23. ' ------
  24. ' America Online: MikeStanly    (Via Internet: mikestanly@aol.com)
  25. ' CompuServe:     74632,2227
  26. '
  27. '
  28. ' Mike Stanley
  29. ' Independent Consultant
  30. ' New Hampshire
  31. ' USA
  32.  
  33. Const PIXELS = 3
  34. Const RED_1 = &HF0&
  35. Const RED_2 = &HFF&
  36. Const GCW_HCURSOR = -12
  37. Const GWW_HINSTANCE = -6
  38. Const BITS_OFFSET = 12
  39. Const ICON_SIZE = 32
  40.  
  41. Type CursorInfo
  42.      hWnd       As Integer
  43.      hOldCursor As Integer
  44.      hNewCursor As Integer
  45. End Type
  46.  
  47. Declare Function GlobalLock& Lib "Kernel" (ByVal hMem%)
  48. Declare Function GlobalUnLock% Lib "Kernel" (ByVal hMem%)
  49. Declare Function CreateCursor% Lib "User" (ByVal hinst%, ByVal xHotSpot%, ByVal yHotSpot%, ByVal nWidth%, ByVal nHeight%, ByVal lpvANDPlane As Any, ByVal lpvXORPlane As Any)
  50. Declare Function DestroyCursor% Lib "User" (ByVal hcur%)
  51. Declare Function GetWindowWord% Lib "User" (ByVal hWnd%, ByVal nIndex%)
  52. Declare Function SetClassWord% Lib "User" (ByVal hWnd%, ByVal nIndex%, ByVal wNewWord%)
  53. Declare Function GetPixel& Lib "GDI" (ByVal hDC%, ByVal nXPos%, ByVal nYPos%)
  54.  
  55. Function ChangeCursor (ByVal hWnd As Integer, hCursor As Integer)
  56.     
  57.     ChangeCursor = SetClassWord(hWnd, GCW_HCURSOR, hCursor)
  58.  
  59. End Function
  60.  
  61. Sub FindHotSpot (CursorPic As Control, x As Integer, y As Integer)
  62.     
  63. Dim PixelColor As Long
  64.  
  65.     For x = 0 To (ICON_SIZE - 1)
  66.     For y = 0 To (ICON_SIZE - 1)
  67.         PixelColor = GetPixel(CursorPic.hDC, x, y)
  68.         If (PixelColor >= RED_1) And (PixelColor <= RED_2) Then Exit Sub
  69.     Next y
  70.     Next x
  71.  
  72.     x = 0: y = 0
  73.  
  74. End Sub
  75.  
  76. Sub MakeCursor (ByVal hWnd As Integer, picCursor As Control, picMask As Control, ciCursor As CursorInfo)
  77.  
  78. Dim x As Integer, y As Integer
  79.                 
  80.  
  81.     picCursor.AutoRedraw = True
  82.     picCursor.ScaleMode = PIXELS
  83.     picMask.ScaleMode = PIXELS
  84.     
  85.     FindHotSpot picCursor, x, y
  86.     
  87.     ciCursor.hWnd = hWnd
  88.     ciCursor.hNewCursor = CreateCursor(GetWindowWord(hWnd, GWW_HINSTANCE), x, y, ICON_SIZE, ICON_SIZE, GlobalLock(picCursor.Picture) + BITS_OFFSET, GlobalLock(picMask.Picture) + BITS_OFFSET)
  89.     ciCursor.hOldCursor = ChangeCursor(hWnd, ciCursor.hNewCursor)
  90.     
  91.     z% = GlobalUnLock(picCursor.Picture)
  92.     z% = GlobalUnLock(picMask.Picture)
  93.     picCursor.AutoRedraw = False
  94.  
  95. End Sub
  96.  
  97. Sub RestoreCursor (ciCursor As CursorInfo)
  98.     
  99.     z% = ChangeCursor(ciCursor.hWnd, ciCursor.hOldCursor)
  100.     z% = DestroyCursor(ciCursor.hNewCursor)
  101.  
  102. End Sub
  103.  
  104.